
package Sgdb::ControlPanel ;
use Sgdb::Utils qw(:DEFAULT
                   isbusy
                   menu_pop_NB_Raise
                   gdb_sources
                   ) ;

use warnings ;
use strict ;
use integer ;
use bytes ;

my $tracepoints_mode ;
my $control ;

sub new {

    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;

    $control = $topf->Frame(-relief => 'sunken' );

    drow_buttons() ;

    hook_add 'reconfigure-all' => [\&drow_buttons] ;
    hook_add 'connect-target'  => [\&drow_tracepoints_buttons] ;
    $control ;
}

sub drow_tracepoints_buttons {

    my $type = shift     or return ;
    $type eq 'symmetrix' or return ;
    $tracepoints_mode   and return ;
    $tracepoints_mode = 1 ;
    # NOTE: the drow_buttons command should not be
    # used under busy (deleted buttons won't unbusy
    # themselves)
    if ( isbusy ) {
        unbusy ;
        drow_buttons() ;
        busy ;
    } else {
        drow_buttons() ;
    }
}
sub drow_buttons {

    return unless istkwidget $control ;

    foreach my $b ( $control -> packSlaves () ) {$b -> destroy}

    add_raise_source_page_menu( $control ) ;
    add_buttons_to_panel( $control ) ;
    add_sources_browse_entry ( $control ) ;
    add_cleanup_button( $control ) ;
}

my $raise_source_button ;
sub add_raise_source_page_menu {
    $raise_source_button =
      balloonset "Raise Source Pane",
        $_[0] -> Button ( -image => pref_image ('raise-source'),
                          -command => \&raise_source_menu,
                        ) -> pack (qw/-anchor nw -side left/) ;
}

sub raise_source_menu {
    my $m =
        menu_pop_NB_Raise($raise_source_button,
                          &Sgdb::PanesWin::source_notebook) ;

    configure $m pref 'raise-pane-pop-menu' ;
    my $b = $raise_source_button ;
    $m -> Post($b -> rootx (),
               $b -> rooty () +
               $b -> height()
              ) ;
}

sub add_sources_browse_entry {

    return unless pref ( 'control-panel-buttons-list' ) =~ /\bsource_browser\b/ ;

    my $control = shift ;
    $control -> BrowseEntry( pref ( 'control-panel-browse-entry' ) ,
                             -browsecmd  => \&open_source_file ,
                             -listcmd    => \&insert_source_names,
                             -background => $control -> cget ( '-background' ),
                             ) -> pack ( -anchor => 'nw',
                                         -side   => 'left' ,
                                         ) ;

}

sub add_cleanup_button {

    return unless pref ( 'control-panel-buttons-list' ) =~ /\bcleanup\b/ ;

    my $control = shift ;
    balloonset <<DoC =>
Terminate ALL!
DoC
      $control -> Button ( -image => pref_image ( 'cleanup' ),
                           -command => sub {
                               hook_run 'close-all-sources' ;
                               hook_run 'invalid-symbol-file' ;
                               hook_run 'close-swuch' ;
                           },
                         ) -> pack ( -anchor => 'nw',
                                     -side   => 'left',
                                     -padx    => '1c'
                                     ) ;
}

sub tfind_prev {

    my ($i) = gdb_exec( 'info traced-frame' ) =~ /frame (\d+)/ ;
    $i ? gdb_exec ('tfind ' . ( $i - 1 ) ) : gdb_exec( 'tfind 0' ) ;
}

sub add_buttons_to_panel {

    my $control = shift ;
    my $list    = shift ;
    unless ( defined $list ) {

        if ( $tracepoints_mode ) {
            $list = pref ('control-panel-buttons-tracepoints-list') ;
        }
        else {
            $list = pref ('control-panel-buttons-list' ) ;
        }
    }

    # 1. button name (gif file with this name will be searched)
    # 2. balloon documentation (default: button name)
    # 3. command (default: button name)
    #    if command is a string it assumes to be a simple gdb command
    #    single string in array doesn't really have to be in an array

    foreach my $p (['tstart',
                    'Start tracing!'
                   ],
                   ['tstop',
                    'Stop tracing!'
                   ],
                   ['tstart_all',
                    'Start tracing all connected targets!',
                    [\&hook_run_lock, 'exec-multi-target-cmd', 1, 1, 'tstart']
                   ],
                   ['tstop_all',
                    'Stop tracing all connected targets!',
                    [\&hook_run_lock, 'exec-multi-target-cmd', 1, 1, 'tstop']
                   ],
                   ['tfind',
                    'Find the next frame!'
                   ],
                   ['tfind_prev',
                    'Find the previous frame!' ,
                    [\&runlocked, \&tfind_prev],
                   ],
                   ['tfind_line',
                    'Find a frame in a different source line!' ,
                    'tfind line',
                   ],
                   ['tfind_none',
                    'Mark the current frame as invalid!' ,
                    'tfind none',
                   ],
                   ['tfind_this_pc',
                    'Find another frame on the current PC!' ,
                    'tfind pc $pc' ,
                   ],
                   ['tstatus',
                    'Display the trace status on the remote side!'
                   ],
                   ['swuch',
                    'Open the Swuch window!',
                    [\&hook_run, 'add-swuch-window']
                   ],
                   ['swuchChat-16',
                    'open Chat window',
                    [\&hook_run, 'new-chat-window'],
                   ],
                   # breakpoints mode buttons
                   'step',
                   'stepi',
                   'next',
                   'load',
                   'continue',
                   'up',
                   'down',
                  ) {

        my ($name, $balloon, $cmd ) = ( ref $p ?
                                        (@$p, @$p, @$p) :
                                        ( $p,  $p,  $p)

                                        # (ok ok I'm lazy, this is not a real time code)
                                      ) ;
        $list =~ /\b$name\b/ or next ;

        balloonset
          $control -> Button ( -image   => pref_image ( $name ),
                               -command => (ref $cmd ?
                                            $cmd :
                                            [\&gdb_exec_lock, $cmd] ) ,
                             ) -> pack ( -anchor => 'nw',
                                         -side   => 'left' ) =>  $balloon || ''
                                     }
}

sub insert_source_names {
    my $s = shift ;
    $s -> delete ( 0 => 'end' ) ;
    $s -> insert ('end', $_ ) for sort map { /([^\/]+)$/ }  @{ gdb_sources() }
}

sub open_source_file {
    busy ;
    my ($s, $file) = @_ ;
    $file ||= $s -> get() ;
    hook_run('open-source-file', $file) ;
    unbusy ;
}

'end'
